home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d22 / fdformat.arc / FDFORMAT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-10-02  |  28.2 KB  |  825 lines
  1. {$A+,B-,D+,E+,F-,I-,L+,N-,O-,R-,S-,V-}
  2. {$M 8192,0,0}
  3. Program FDFORMAT;
  4.  
  5. uses dos;
  6.  
  7. {Copyright (c) 1988, Christoph H. Hochstätter}
  8. {Written in Turbo-Pascal 5.0}
  9. {Last Updated: 26-Mar-1989}
  10.  
  11. {$DEFINE English} {Change this to German or English}
  12. {$IFDEF German}
  13.  
  14. const text01 = 'Fehler ';
  15. const text02 = '(A)bbrechen (W)iederholen (I)gnorieren ? ';
  16. const t3     = 'W';
  17. const text04 = 'Kein gültiges Laufwerk.';
  18. const text05 = 'SUBST/ASSIGN/Netzwerk-Laufwerk.';
  19. const text06 = 'Kein Floppy-Laufwerk.';
  20. const text07 = 'Völlig unbekannte Laufwerksart';
  21. const text08 = 'Ich formatiere Laufwerk ';
  22. const text09 = ' Seite(n), ';
  23. const text10 = ' Spuren, ';
  24. const text11 = ' Sektoren/Spur, ';
  25. const text12 = ' Basisverzeichniseinträge, ';
  26. const text13 = ' Sektor(en)/Cluster, Sektoren-Versatz: ';
  27. const text14 = 'Kopf: ';
  28. const text15 = ', Zylinder: ';
  29. const text16 = ', Sektor: ';
  30. const text17 = 'Formatierfehler im Systembereich: Programm abgebrochen.';
  31. const text18 = 'Mehr als ';
  32. const text19 = ' Sektoren nicht lesbar. Programm abgebrochen.';
  33. const text20 = ' als schlecht markiert';
  34. const text21 = 'Format-Identifizierung:          ';
  35. const text22 = 'Gesamtsektoren auf der Diskette: ';
  36. const text23 = 'Sektoren pro Spur:               ';
  37. const text24 = 'Schreib-/Leseköpfe:              ';
  38. const text25 = 'Bytes pro Sektor:                ';
  39. const text26 = 'Versteckte Sektoren:             ';
  40. const text27 = 'Boot-Sektoren:                   ';
  41. const text28 = 'Anzahl der FAT''s:                ';
  42. const text29 = 'Sektoren pro FAT:                ';
  43. const text30 = 'Cluster auf Diskette:            ';
  44. const text31 = ' Bytes Gesamtkapazität';
  45. const text32 = ' Bytes in schlechten Sektoren';
  46. const text33 = ' Bytes auf der Diskette verfügbar';
  47. const text34 = 'Dieses Laufwerk kann nicht formatiert werden.';
  48. const text35 = 'Laufwerk ist physisch ';
  49. const text36 = 'BIOS Umschaltung 40/80 Spuren: ';
  50. const text37 = 'nach XT-Standard';
  51. const text38 = 'nach EPSON QX-16 Standard';
  52. const text39 = 'nach AT-Standard';
  53. const text40 = 'wird nicht unterstützt';
  54. const text41 = 'Syntax Error beim Aufruf.';
  55. const text42 = 'Format ist: FDFORMAT drive: [Optionen]';
  56. const text43 = '  Beispiel: FDFORMAT a: t41 h2 s10 C1 D112';
  57. const text44 = 'Parameter Bedeutung                              Voreinstellung';
  58. const text45 = 'drive:    Laufwerk, das formatiert werden soll   ----';
  59. const text46 = 'Tnn       Anzahl der Spuren je Seite             40/80 je nach Laufwerk';
  60. const text47 = 'Hnn       Anzahl der Seiten                      2';
  61. const text48 = 'Snn       Anzahl der Sektoren je Spur            9/15/18 je nach Laufwerk';
  62. const text49 = 'Cn        Anzahl der Sektoren je Cluster         1 bei HD, 2 bei DD';
  63. const text50 = 'Dnnn      Anzahl der Basisverzeichniseinträge    224 bei HD, 112 bei DD';
  64. const text51 = 'Inn       Interleave-Faktor                      1';
  65. const text52 = 'P         Spezielle Einstellung für PS/2';
  66. const text53 = 'V         Formatierung nicht verifizieren';
  67. const text69 = 'Bnnn      Diskettentypbyte festlegen             je nach Format');
  68. const text70 = 'Gnnn      GAP-Länge festlegen');                 je nach Format');
  69. const text71 = 'Fnn       Sektoren-Versatz festlegen             0';
  70. const text54 = 'Dieses Programm benötigt mindestens DOS 3.20.';
  71. const text55 = 'FDFORMAT -- Formatieren von Disketten mit erhöhter Kapazität';
  72. const text56 = 'Copyright (c) 26.03.1989, Christoph H. Hochstätter, Ver 1.20';
  73. const text57 = 'Sie können nur 1 oder 2 Seiten nehmen.';
  74. const text58 = 'Sie sollten schon mindestens eine Spur formatieren.';
  75. const text59 = 'Interleave muß von 1-';
  76. const text60 = ' sein.';
  77. const text61 = 'WARNUNG! DOS verwaltet bei Disketten nur 1 oder 2 Sektoren/Cluster';
  78. const text62 = 'WARNUNG! Zu viele Spuren. Das kann Ihr Laufwerk beschädigen';
  79. const text63 = 'WARNUNG! DOS verwaltet bei Disketten maximal 240 Basisverzeichniseinträge';
  80. const text64 = 'Neue Diskette in Laufwerk ';
  81. const text65 = ': einlegen';
  82. const text66 = 'Anschließend ENTER drücken (ESC=Abbruch)';
  83. const text67 = ', Sektoren-Versatz: ';
  84. const text68 = ', GAP-Länge: ';
  85.  
  86. {$ENDIF}
  87. {$IFDEF English}
  88.  
  89. const text01 = 'Error ';
  90. const text02 = '(A)bort (R)etry (I)gnore ? ';
  91. const t3     = 'R';
  92. const text04 = 'No valid drive.';
  93. const text05 = 'SUBST/ASSIGN/Network-Drive.';
  94. const text06 = 'Not a floppy drive.';
  95. const text07 = 'Unknown drive type.';
  96. const text08 = 'Formatting drive ';
  97. const text09 = ' Head(s), ';
  98. const text10 = ' Tracks, ';
  99. const text11 = ' Sectors/track, ';
  100. const text12 = ' Root Directory Entries, ';
  101. const text13 = ' Sector(s)/Cluster, Sector-Shift: ';
  102. const text14 = 'Head: ';
  103. const text15 = ', Cylinder: ';
  104. const text16 = ', Sector: ';
  105. const text17 = 'Format error in system area: Program aborted.';
  106. const text18 = 'More than ';
  107. const text19 = ' sectors unreadable. Program aborted.';
  108. const text20 = ' marked as bad';
  109. const text21 = 'OEM-Entry:              ';
  110. const text22 = 'Total sectors on disk:  ';
  111. const text23 = 'Sectors per track:      ';
  112. const text24 = 'Heads:                  ';
  113. const text25 = 'Bytes per sector:       ';
  114. const text26 = 'Hidden sectors:         ';
  115. const text27 = 'Boot-sectors:           ';
  116. const text28 = 'Number of FATs:         ';
  117. const text29 = 'Sectors per FAT:        ';
  118. const text30 = 'Total clusters on disk: ';
  119. const text31 = ' total bytes on disk';
  120. const text32 = ' bytes in bad sectors';
  121. const text33 = ' bytes available';
  122. const text34 = 'This drive cannot be formatted.';
  123. const text35 = 'Drive is physical ';
  124. const text36 = 'BIOS double-step support: ';
  125. const text37 = 'XT-like';
  126. const text38 = 'EPSON QX-16 like';
  127. const text39 = 'AT-like';
  128. const text40 = 'Not available or unknown';
  129. const text41 = 'Syntax Error.';
  130. const text42 = 'Usage is: FDFORMAT drive: [options]';
  131. const text43 = ' Example: FDFORMAT a: t41 h2 s10 C1 D112';
  132. const text44 = 'Option   Meaning                                 Default';
  133. const text45 = 'drive:   drive to be formatted                   none';
  134. const text46 = 'Tnn      Number of tracks                        40/80 depends on drive';
  135. const text47 = 'Hnn      Number of heads                         2';
  136. const text48 = 'Snn      Number of sectors per track             9/15/18 depends on drive';
  137. const text49 = 'Cn       Number of sectors per cluster           1 for HD, 2 for DD';
  138. const text50 = 'Dnnn     Number of root directory entries        224 for HD, 112 for DDD';
  139. const text51 = 'Inn      Interleave                              1';
  140. const text52 = 'P        for use on PS/2 Computers';
  141. const text53 = 'V        Skip verifying';
  142. const text69 = 'Bnnn     Force a specified Format-Descriptor     depends on format';
  143. const text70 = 'Gnnn     Use specified GAP-Length                depends on format';
  144. const text71 = 'Fnn      Use specified Sector-Shift              0';
  145. const text54 = 'This program requires DOS 3.2 or higher.';
  146. const text55 = 'FDFORMAT - Disk Formatter for High Capacity Disks - Ver 1.20';
  147. const text56 = 'Copyright (c) 26-Mar-1989, Christoph H. Hochstätter, Germany';
  148. const text57 = 'Heads must be 1 or 2.';
  149. const text58 = 'At least one track should be formatted.';
  150. const text59 = 'Interleave must be from 1 to ';
  151. const text60 = '.';
  152. const text61 = 'WARNING! DOS supports only 1 or 2 sectors per cluster.';
  153. const text62 = 'WARNING! That many tracks could cause damage to your drive.';
  154. const text63 = 'WARNING! DOS supports a maximum of 240 root directory entries.';
  155. const text64 = 'Insert Diskette in drive ';
  156. const text65 = ':';
  157. const text66 = 'Press ENTER when ready (ESC=QUIT)';
  158. const text67 = 'Sector-Shift: ';
  159. const text68 = ', GAP-Length: ';
  160.  
  161. {$ENDIF}
  162.  
  163. type tabletyp = array[1..25] of record
  164.                   t,h,s,f:byte;
  165.         end;
  166.  
  167.      paratyp =  array[0..10] of byte;
  168.      boottyp =  array[30..511] of byte;
  169.  
  170.      btttyp  =  array[1..20] of record
  171.                   head:  byte;
  172.                   track: byte;
  173.                 end;
  174.  
  175.      bpbtyp  =  record
  176.           jmp: array[1..3] of byte;  {Die ersten drei Bytes für JUMP}
  177.           oem: array[1..8] of char;  {OEM-Eintrag}
  178.           bps: word;                 {Bytes pro Sektor}
  179.           spc: byte;                 {Sektoren pro Cluster}
  180.           res: word;                 {BOOT-Sektoren}
  181.           fat: byte;                 {Anzahl der FAT's}
  182.           rde: word;                 {Basisverzeichniseinträge}
  183.           sec: word;                 {Gesamtsektoren der Diskette}
  184.           mds: byte;                 {Media-Deskriptor}
  185.           spf: word;                 {Sektoren pro FAT}
  186.           spt: word;                 {Sektoren pro Spur}
  187.           hds: word;                 {Seiten}
  188.           shh: word;                 {Versteckte Sektoren}
  189.           boot_code: boottyp;        {Puffer für BOOT-Code}
  190.         end;
  191.  
  192. var regs:       registers;                {Prozessor-Register}
  193.     track:      byte;                     {Aktuelle Spur}
  194.     head:       byte;                     {Aktuelle Seite}
  195.     table:      tabletyp;                 {Formatierungs-Tabelle}
  196.     table2:     array[1..25] of byte;     {Interleave-Tabelle}
  197.     x:          word;                     {Hilfsvariable}
  198.     buffer:     array[0..18432] of byte;  {Puffer für eingelesene Sektoren}
  199.     old1E:      pointer;                  {Alter Zeiger auf die Parameterliste}
  200.     new1E:      ^paratyp;                 {Neuer Zeiger auf die Parameterliste}
  201.     old13:      pointer;                  {Alter Zeiger auf Interrupt 13}
  202.     old58:      pointer;                  {Alter Zeiger auf Hilfsinterrupt 58}
  203.     bpb:    bpbtyp;                   {Boot-Sektor mit BIOS-Parameterblock}
  204.     chx:        Char;                     {Hilfsvariable}
  205.     lw:         Byte;                     {Ausgewähltes Laufwerk}
  206.     hds,sec:    word;                     {Anzahl der Seiten, Sektoren}
  207.     trk:        word;                     {Anzahl der Spuren}
  208.     hd,lwhd:    Boolean;                  {High-Density Flags}
  209.     lwtrk:      byte;                     {maximale Spuren des Laufwerks}
  210.     lwsec:      byte;                     {maximale Sektoren des Laufwerks}
  211.     para:    String[5];                {Parameter von der Kommandozeile}
  212.     rde:    byte;                     {Basisverzeichniseinträge}
  213.     spc:    byte;                     {Sektoren pro Cluster}
  214.     i,n:    byte;                     {Hilfsvariablen}
  215.     j:        integer;                  {Hilfsvariable}
  216.     again:      boolean;                  {Flag, ob INT 13 nochmal kommen muß}
  217.     bttCount:   word;                     {Anzahl der schlechten Spuren}
  218.     btt:        btttyp;                   {Tabelle der schlechten Spuren}
  219.     Offset:     word;                     {Relative Position im FAT}
  220.     Mask:       word;                     {Maske für schlechten Cluster}
  221.     bytes:    LongInt;                  {Bytes Gesamtkapazität}
  222.     bad:        Longint;                  {Bytes in schlechten Sektoren}
  223.     pc80:    Byte;                     {Maske, für 40/80 Spur nach XT-BIOS}
  224.     at80:       Boolean;                  {TRUE, wenn 80/40 Spur nach AT-BIOS}
  225.     ps2:        Boolean;                  {TRUE, wenn PS2}
  226.     noverify:   Boolean;                  {TRUE, wenn Verify nicht verlangt wurde}
  227.     DiskId:     Byte;                     {Disketten-Format-Beschreibung für AT-BIOS}
  228.     il:         Byte;                     {Interleave-Faktor}
  229.     gpl:        Byte;                     {GAP-Länge}
  230.     shift:      Byte;                     {Sektor-Shifting}
  231.     ModelByte:  Byte absolute $F000:$FFFE {XT/AT/386};
  232.     ForceType:  Byte;                     {Gezwungener Diskid}
  233.  
  234. const para17:  paratyp =($df,$02,$25,$02,17,$1b,$ff,$23,$00,$0f,$08);
  235.       para18a: paratyp =($df,$02,$25,$02,18,$1b,$ff,$02,$00,$0f,$08);
  236.       para18:  paratyp =($df,$02,$25,$02,18,$1b,$ff,$6c,$00,$0f,$08);
  237.       para10:  paratyp =($df,$02,$25,$02,10,$2a,$ff,$2e,$00,$0f,$08);  {GPL 26-36}
  238.       para11:  paratyp =($df,$02,$25,$02,11,$2a,$ff,$02,$00,$0f,$08);
  239.       para15:  paratyp =($df,$02,$25,$02,15,$1b,$ff,$54,$00,$0f,$08);
  240.       para09:  paratyp =($df,$02,$25,$02,09,$2a,$ff,$50,$00,$0f,$08);
  241.       para08:  paratyp =($df,$02,$25,$02,08,$2a,$ff,$58,$00,$0f,$08);
  242.       para20:  paratyp =($df,$02,$25,$02,20,$1b,$ff,$25,$00,$0f,$08);  {GPL 17-33}
  243.       para21:  paratyp =($df,$02,$25,$02,21,$1b,$ff,$0c,$00,$0f,$08);
  244.       para22:  paratyp =($df,$02,$25,$02,22,$1b,$ff,$01,$00,$0f,$08);
  245.  
  246.       GetPhys: Array[0..14] of Byte =(
  247.  
  248.             $1E,               {  PUSH DS             }
  249.         $B8,$40,$00,       {  MOV  AX,40H         }
  250.         $8E,$D8,           {  MOV  DS,AX          }
  251.             $88,$16,$41,$00,   {  MOV  [41H],DL       }
  252.             $1F,               {  POP  DS             }
  253.             $B8,$01,$01,       {  MOV  AX,101H        }
  254.             $CF);              {  IRET                }
  255.  
  256.       Help58: Array[0..3] of Byte =(
  257.  
  258.             $CD,$25,           {  INT  25H            }
  259.             $59,               {  POP  CX             }
  260.             $CF);              {  IRET                }
  261.  
  262. {$IFDEF German}
  263.  
  264.       boot: boottyp=(
  265. 0,0,0,0,0,0,0,0,250,184,48,
  266. 0,142,208,188,252,0,251,14,31,187,7,0,190,92,124,144,138,4,70,60,
  267. 0,116,8,180,14,86,205,16,94,235,241,180,1,205,22,116,6,180,0,205,
  268. 22,235,244,180,0,205,22,51,210,205,25,13,10,68,105,101,115,101,32,68,
  269. 105,115,107,101,116,116,101,32,119,117,114,100,101,32,109,105,116,32,72,68,
  270. 70,79,82,77,65,84,32,102,111,114,109,97,116,105,101,114,116,46,32,83,
  271. 105,101,32,105,115,116,32,110,105,99,104,116,32,66,79,79,84,45,102,132,
  272. 104,105,103,46,13,10,77,105,116,32,100,101,109,32,68,79,83,45,66,101,
  273. 102,101,104,108,32,83,89,83,32,107,97,110,110,32,115,105,101,32,66,79,
  274. 79,84,45,102,132,104,105,103,32,103,101,109,97,99,104,116,32,119,101,114,
  275. 100,101,110,44,13,10,119,101,110,110,32,83,105,101,32,111,104,110,101,32,
  276. 72,68,82,69,65,68,32,103,101,108,101,115,101,110,32,119,101,114,100,101,
  277. 110,32,107,97,110,110,46,13,10,10,84,97,117,115,99,104,101,110,32,83,
  278. 105,101,32,100,105,101,32,68,105,115,107,101,116,116,101,32,106,101,116,122,
  279. 116,32,97,117,115,32,111,100,101,114,32,148,102,102,110,101,110,32,83,105,
  280. 101,32,100,105,101,32,75,108,97,112,112,101,44,13,10,119,101,110,110,32,
  281. 83,105,101,32,118,111,110,32,100,101,114,32,70,101,115,116,112,108,97,116,
  282. 116,101,32,98,111,111,116,101,110,32,109,148,99,104,116,101,110,46,13,10,
  283. 10,68,114,129,99,107,101,110,32,83,105,101,32,101,105,110,101,32,84,97,
  284. 115,116,101,13,10,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  285. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  286. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  287. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  288. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  289. 0,0,0,0,0,0,0,0,0,85,170);
  290.  
  291. {$ENDIF}
  292. {$IFDEF English}
  293.  
  294.       boot: boottyp=(
  295. $00,$00,
  296. $00,$00,$00,$00,$00,$00,$FA,$B8,$30,$00,$8E,$D0,$BC,$FC,$00,$FB,
  297. $0E,$1F,$BB,$07,$00,$BE,$5C,$7C,$90,$8A,$04,$46,$3C,$00,$74,$08,
  298. $B4,$0E,$56,$CD,$10,$5E,$EB,$F1,$B4,$01,$CD,$16,$74,$06,$B4,$00,
  299. $CD,$16,$EB,$F4,$B4,$00,$CD,$16,$33,$D2,$CD,$19,$0D,$0A,$54,$68,
  300. $69,$73,$20,$44,$69,$73,$6B,$65,$74,$74,$65,$20,$77,$61,$73,$20,
  301. $66,$6F,$72,$6D,$61,$74,$74,$65,$64,$20,$77,$69,$74,$68,$20,$48,
  302. $44,$46,$4F,$52,$4D,$41,$54,$2E,$20,$49,$74,$20,$69,$73,$20,$6E,
  303. $6F,$74,$20,$62,$6F,$6F,$74,$61,$62,$6C,$65,$2E,$0D,$0A,$54,$6F,
  304. $20,$6D,$61,$6B,$65,$20,$69,$74,$20,$62,$6F,$6F,$74,$61,$62,$6C,
  305. $65,$20,$75,$73,$65,$20,$74,$68,$65,$20,$44,$4F,$53,$2D,$43,$6F,
  306. $6D,$6D,$61,$6E,$64,$3A,$20,$53,$59,$53,$2E,$0D,$0A,$54,$68,$69,
  307. $73,$20,$77,$6F,$72,$6B,$73,$20,$6F,$6E,$6C,$79,$2C,$20,$69,$66,
  308. $20,$79,$6F,$75,$20,$63,$61,$6E,$20,$72,$65,$61,$64,$20,$74,$68,
  309. $69,$73,$20,$44,$69,$73,$6B,$65,$74,$74,$65,$20,$77,$69,$74,$68,
  310. $6F,$75,$74,$20,$48,$44,$52,$45,$41,$44,$2E,$0D,$0A,$0A,$50,$72,
  311. $65,$73,$73,$20,$61,$20,$6B,$65,$79,$20,$74,$6F,$20,$72,$65,$62,
  312. $6F,$6F,$74,$2E,$0D,$0A,$0A,$0A,$00,$00,$00,$00,$00,$00,$00,$00,
  313. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  314. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  315. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  316. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  317. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  318. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  319. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  320. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  321. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  322. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  323. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  324. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  325. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$55,$AA);
  326.  
  327. {$ENDIF}
  328.  
  329. Function ReadKey:Char;
  330. Var r:Registers;
  331. begin
  332.   with r do begin
  333.     ah:=7;
  334.     intr($21,r);
  335.     if al in [3,27] then begin writeln; halt end;
  336.     ReadKey:=chr(al);
  337.   end;
  338. end;
  339.  
  340. Procedure int13;
  341. var axs: word;
  342.     chs: byte;
  343.     chx: char;
  344.     er:  Boolean;
  345. begin
  346.   again:=false;
  347.   with regs do begin
  348.     axs:=ax;
  349.     repeat
  350.       ax:=axs;
  351.       if ah=5 then SetIntVec($1E,new1E);
  352.       if trk>43 then dl:=dl or pc80;
  353.       mem[$40:$90+dl]:=DiskId;
  354.       intr($13,regs);
  355.       SetIntVec($1E,Old1E);
  356.       er:=ah>1;
  357.     until ah<>6;
  358.     if er then begin
  359.       writeln;
  360.       writeln(text01,regs.ah,': T',ch,' H',dh,' S',cl,'-',
  361.               cl+lo(axs)-1,' L',dl,' C',hi(axs));
  362.       writeln(text02);
  363.       repeat
  364.     chx:=Upcase(ReadKey);
  365.         case chx of
  366.       'A': halt;
  367.       'I': er:=false;
  368.           t3 : begin er:=false; again:=true; end;
  369.         end;
  370.       until chx in ['A','I',t3];
  371.     end;
  372.   ax:=axs;
  373.   end;
  374. end;
  375.  
  376. Procedure GetPhysical(Var lw:Byte);
  377. begin
  378.   with regs do begin
  379.     GetIntVec($58,old58);
  380.     GetIntVec($13,old13);
  381.     SetIntVec($58,@help58);
  382.     SetIntVec($13,@GetPhys);
  383.     al:=lw; cx:=1; dx:=0;
  384.     ds:=seg(buffer); bx:=ofs(buffer);
  385.     intr($58,regs);
  386.     SetIntVec($58,old58);
  387.     SetIntVec($13,old13);
  388.     lw:=mem[$40:$41];
  389.   end;
  390. end;
  391.  
  392. procedure DriveTyp(Var lw:Byte;Var hd:boolean;Var trk,sec:byte);
  393. begin
  394.   with regs do begin
  395.     ax:=$4409; bl:=lw+1; bh:=0;
  396.     intr($21,regs);
  397.     if (FCarry and Flags) <> 0 then begin
  398.       writeln(text04);
  399.       trk:=0;
  400.       exit;
  401.     end;
  402.     if (dx and $9200)<>0 then begin
  403.       writeln(text05);
  404.       trk:=0;
  405.       exit;
  406.     end;
  407.     ax:=$440f; bl:=lw+1; bh:=0;
  408.     intr($21,regs);
  409.     if (FCarry and Flags)<>0 then begin
  410.       writeln(text04);
  411.       trk:=0;
  412.       exit;
  413.     end;
  414.     ax:=$440d; cx:=$860; bl:=lw+1;
  415.     bh:=0; dx:=ofs(buffer); ds:=seg(buffer);
  416.     intr($21,regs);
  417.     case buffer[1] of
  418.       0: begin trk:=39; sec:= 9; hd:=false; end;
  419.       1: begin trk:=79; sec:=15; hd:=true ; end;
  420.       2: begin trk:=79; sec:= 9; hd:=false; end;
  421.       7: begin trk:=79; sec:=18; hd:=true ; end;
  422.     else
  423.       begin
  424.         writeln(text06);
  425.         trk:=0;
  426.         exit;
  427.       end
  428.     end;
  429.     GetPhysical(lw);
  430.     lw:=lw and $9f;
  431.     if not(lw in [0..3]) then begin
  432.       writeln(text07);
  433.       trk:=0;
  434.       exit;
  435.     end;
  436.     ModelByte:=mem[$f000:$fffe];
  437.     at80:=(ModelByte=$f8) or (ModelByte=$fc); pc80:=0;
  438.     if not(at80) then begin
  439.       es:=seg(buffer); bx:=ofs(buffer);
  440.       ax:=$201; cx:=0;
  441.       dh:=0; dl:=lw+$20;
  442.       intr($13,regs);
  443.       if ah<>1 then
  444.         pc80:=$20
  445.       else begin
  446.         dl:=$40+lw; ax:=$201;
  447.         intr($13,regs);
  448.         if ah<>1 then pc80:=$40;
  449.       end;
  450.     end;
  451.   end;
  452. end;
  453.  
  454. Procedure ATSetDrive(lw:Byte; trk,sec,Disk,SetUp:Byte);
  455. begin
  456.   with regs do begin
  457.     dh:=lw; ah:=$18; ch:=trk; cl:=sec;
  458.     intr($13,regs);
  459.     if ah>1 then begin
  460.       ah:=$17; al:=SetUp; dl:=lw;
  461.       intr($13,regs);
  462.     end;
  463.     DiskId:=Disk;
  464.     if ForceType=0 then
  465.       mem[$40:$90+lw]:=Disk
  466.     else
  467.       mem[$40:$90+lw]:=ForceType;
  468.   end;
  469. end;
  470.  
  471. procedure SectorAbsolute(sector:Word;Var hds,trk,sec:Byte);
  472. var h:word;
  473. begin
  474.   sec:=(sector mod bpb.spt)+1;
  475.   h:=sector div bpb.spt;
  476.   trk:=h div bpb.hds;
  477.   hds:=h mod bpb.hds;
  478. end;
  479.  
  480. Function SectorLogical(hds,trk,sec:Byte):Word;
  481. begin
  482.   SectorLogical:=trk*bpb.hds*bpb.spt+hds*bpb.spt+sec-1;
  483. end;
  484.  
  485. Function Cluster(Sector: Word):Word;
  486. Var h: byte;
  487. begin
  488.   Cluster:=((Sector-(bpb.rde shr 4)
  489.             -(bpb.spf shl 1)-1)
  490.            div Word(bpb.spc))+2;
  491. end;
  492.  
  493. Procedure ClusterOffset(Cluster:Word; Var Offset,Mask:Word);
  494. begin
  495.   Offset:=Cluster*3 shr 1;
  496.   if Cluster and 1 = 0 then
  497.     Mask:=$ff7
  498.   else
  499.     Mask:=$ff70;
  500. end;
  501.  
  502. Procedure format;
  503. Var i:Byte;
  504. begin
  505.   if rde and 15 <> 0 then inc(rde,16);
  506.   rde:=rde shr 4;
  507.   if (spc=2) and (rde and 1 = 0) then inc(rde);
  508.   bpb.rde:=rde shl 4;
  509.   case sec of
  510.     0..8:   new1E:=@para08;
  511.     9:      new1E:=@para09;
  512.     10:     new1E:=@para10;
  513.     11:     new1E:=@para11;
  514.     12..15: new1E:=@para15;
  515.     17:     new1E:=@para17;
  516.     18:     if lwsec>17 then
  517.               new1E:=@para18
  518.             else
  519.               new1E:=@para18a;
  520.     19..20: new1E:=@para20;
  521.     21:     new1E:=@para21;
  522.     22..255:new1E:=@para22;
  523.   end;
  524.   if gpl<>0 then
  525.     new1E^[7]:=gpl
  526.   else
  527.     gpl:=new1E^[7];
  528.   writeln;
  529.   write(text08,chr(lw+$41),': ');
  530.   if hd then writeln('High-Density') else writeln('Double-Density');
  531.   writeln(hds,text09,trk,text10,sec,text11,'Interleave: ',il,text68,gpl);
  532.   writeln(bpb.rde,text12,spc,text13,shift);
  533.   writeln;
  534.   bttCount:=0;
  535.   with regs do begin
  536.     for i:=1 to 25 do begin
  537.       table[i].f:=2;
  538.       table2[i]:=0;
  539.     end;
  540.     i:=1;
  541.     n:=1;
  542.     repeat
  543.       repeat
  544.         while table2[n]<>0 do inc(n);
  545.         if n>sec then n:=1;
  546.       until table2[n]=0;
  547.       table2[n]:=i;
  548.       n:=n+il;
  549.       inc(i);
  550.     until i>sec;
  551.     ax:=0;
  552.     bx:=0;
  553.     dl:=lw;
  554.     if at80 then begin
  555.       if (trk>43) and (sec>11) then ATSetDrive(lw,79,lwsec,$14,5);
  556.       if not(ps2) and (trk>43) and (sec<12) then ATSetDrive(lw,79,9,$53,4);
  557.       if ps2 and (trk>43) and (sec<12) then ATSetDrive(lw,79,9,$97,4);
  558.       if (trk<44) and (sec>11) then ATSetDrive(lw,39,lwsec,$34,3);
  559.       if ps2 and (trk<44) and (sec<12) then ATSetDrive(lw,39,9,$B7,2);
  560.       if not(ps2) and (trk<44) and (sec<12) then ATSetDrive(lw,39,9,$73,2);
  561.     end;
  562.     writeln;
  563.     bpb.jmp[1]:=235;
  564.     bpb.jmp[2]:=36;
  565.     bpb.jmp[3]:=144;
  566.     bpb.spt:=sec;
  567.     bpb.hds:=hds;
  568.     bpb.shh:=0;
  569.     bpb.bps:=512;
  570.     bpb.spc:=spc;
  571.     bpb.res:=1;
  572.     bpb.fat:=2;
  573.     bpb.sec:=sec*bpb.hds*trk;
  574.     bpb.boot_code:=boot;
  575.     case bpb.spc of
  576.       1:    if (trk>44) and (bpb.spt in [12..17]) then
  577.                bpb.mds:=$f9
  578.             else
  579.                bpb.mds:=$f0;
  580.       2:    if trk in [1..43] then bpb.mds:=$fd else bpb.mds:=$f9;
  581.       else  bpb.mds:=$f8;
  582.     end;
  583.     bpb.spf:=trunc(bpb.sec*1.5/512/bpb.spc)+1;
  584.     dl:=lw;
  585.     ax:=0;
  586.     repeat int13 until not again;
  587.     for track:=0 to trk-1 do begin
  588.       n:=shift mod sec;
  589.       for i:=1 to sec do
  590.         table[i].s:=table2[(i+n-1) mod sec + 1];
  591.       for head:=0 to hds-1 do begin
  592.         write(text14,head,text15,track);
  593.         x:=SectorLogical(head,track,1);
  594.         write(text16,x);
  595.         x:=Cluster(x);
  596.         if (x>1) and (x<10000) then write(', Cluster: ',x);
  597.         for i:=1 to sec do begin
  598.       table[i].t:=track;
  599.       table[i].h:=head;
  600.         end;
  601.         repeat
  602.           ah:=5;
  603.           al:=sec;
  604.           dl:=lw;
  605.           dh:=head;
  606.           ch:=track;
  607.           cl:=1;
  608.           es:=seg(table);
  609.           bx:=ofs(table);
  610.           write('  F');
  611.           mem[$40:$41]:=0;
  612.           int13;
  613.           write(#8,'V        ');write(#13);
  614.           if not(again or noverify) then begin
  615.             ah:=2;
  616.             dl:=lw;
  617.         es:=seg(buffer);
  618.         bx:=ofs(buffer);
  619.             int13;
  620.           end;
  621.         until not again;
  622.         if (FCarry and flags) <> 0 then begin
  623.           if (x<2) or (x>10000) then begin
  624.             writeln(text17);
  625.             halt;
  626.           end;
  627.           inc(bttCount);
  628.           if bttCount>20 then begin
  629.             writeln(text18,20*sec,text19);
  630.             halt;
  631.           end;
  632.           btt[bttCount].track:=track;
  633.           btt[bttCount].head:=head;
  634.           writeln(text14,head,text15,track,text20);
  635.         end;
  636.       end;
  637.     end;
  638.   end;
  639. end;
  640.  
  641. Procedure WriteBootSect;
  642. begin
  643.   with regs do begin
  644.     writeln; bpb.oem:='CH-FOR12'; writeln;
  645.     writeln(text21,bpb.oem); writeln(text22,bpb.sec);
  646.     writeln(text23,bpb.spt); writeln(text24,bpb.hds);
  647.     writeln(text25,bpb.bps); writeln(text26,bpb.shh);
  648.     writeln(text27,bpb.res); writeln(text28,bpb.fat);
  649.     writeln(text29,bpb.spf); writeln(text30,Cluster(bpb.sec)-2);
  650.     dh:=0; dl:=lw; ch:=0; cl:=1;
  651.     al:=1; ah:=3; es:=seg(bpb);
  652.     bx:=ofs(bpb);
  653.     repeat int13 until not again;
  654.     fillchar(buffer[3],18430,#0);
  655.     buffer[0]:=bpb.mds;
  656.     buffer[1]:=$ff;
  657.     buffer[2]:=$ff;
  658.     bad:=0;
  659.     for i:=1 to bttCount do
  660.       for j:=1 to sec do begin
  661.         x:=SectorLogical(btt[i].head,btt[i].track,j);
  662.         x:=Cluster(x);
  663.         ClusterOffset(x,Offset,Mask);
  664.         if buffer[Offset] and Lo(Mask)=0 then inc(bad,bpb.spc*512);
  665.         buffer[Offset]:=buffer[Offset] or Lo(Mask);
  666.         buffer[Offset+1]:=buffer[Offset+1] or Hi(Mask);
  667.       end;
  668.     es:=seg(buffer);
  669.     bx:=ofs(buffer);
  670.     inc(cl);
  671.     al:=bpb.spf;
  672.     repeat int13 until not again;
  673.     SectorAbsolute(bpb.spf+1,dh,ch,cl);
  674.     ah:=3;
  675.     dl:=lw;
  676.     if bpb.spf+cl>sec+1 then al:=sec-cl+1;
  677.     repeat int13 until not again;
  678.     if bpb.spf+cl>sec+1 then begin
  679.       bx:=bx+al*512;
  680.       al:=bpb.spf-al;
  681.       inc(dh);
  682.       cl:=1;
  683.       repeat int13 until not again;
  684.     end;
  685.     Bytes:=LongInt(Cluster(bpb.sec)-2)*512*LongInt(bpb.spc);
  686.     writeln;
  687.     writeln(Bytes:9,text31);
  688.     if bad<>0 then writeln(bad:9,text32);
  689.     writeln(Bytes-bad:9,text33);
  690.     writeln;
  691.   end;
  692. end;
  693.  
  694. Procedure DrivePrt;
  695. begin
  696.   writeln;
  697.   if lwtrk=0 then begin
  698.     writeln(text34);
  699.     exit;
  700.   end;
  701.   write(text35,chr(lw+$41));
  702.   if lwhd then
  703.     write(': High-Density, ')
  704.   else
  705.     write(': Double-Density, ');
  706.   writeln(lwtrk+1,text10,lwsec,text11);
  707.   write(text36);
  708.   if pc80=$20 then writeln(text37);
  709.   if pc80=$40 then writeln(text38);
  710.   if at80 then writeln(text39);
  711.   if not(at80) and (pc80=0) then writeln(text40);
  712.   writeln;
  713. end;
  714.  
  715. Procedure SyntaxError;
  716. begin
  717.   writeln; writeln(text41); writeln;
  718.   writeln(text42); writeln(text43); writeln;
  719.   writeln(text44); writeln; writeln(text45);
  720.   writeln(text46); writeln(text47); writeln(text48);
  721.   writeln(text49); writeln(text50); writeln(text51);
  722.   writeln(text52); writeln(text53);
  723.   writeln(text69); writeln(text70);
  724.   writeln(text71); writeln;
  725.   halt;
  726. end;
  727.  
  728. Procedure CheckDos;
  729. var Version: Word;
  730. begin
  731.   Version:=swap(DosVersion);
  732.   if Version<$314 then begin
  733.     writeln(text54);
  734.     halt;
  735.   end;
  736. end;
  737.  
  738. begin
  739.   writeln;
  740.   writeln(text55);
  741.   writeln(text56);
  742.   CheckDos;
  743.   GetIntVec($1E,old1E);
  744.   new1E:=old1E;
  745.   para:=paramstr(1);
  746.   ps2:=false;
  747.   noverify:=false;
  748.   if (length(para)<>2) or (para[2]<>':') then SyntaxError;
  749.   lw:=ord(UpCase(para[1]))-$41;
  750.   DriveTyp(lw,lwhd,lwtrk,lwsec);
  751.   DrivePrt;
  752.   if (lwtrk=0) and (para<>'') then halt;
  753.   rde:=0;
  754.   il:=0;
  755.   spc:=0;
  756.   gpl:=0;
  757.   shift:=0;
  758.   ForceType:=0;
  759.   trk:=lwtrk+1;
  760.   sec:=lwsec;
  761.   hds:=2;
  762.   for i:=2 to paramcount do
  763.     if paramstr(i)<>'' then begin
  764.       para:=paramstr(i);
  765.       chx:=para[1];
  766.       if length(para)=1 then
  767.         case UpCase(chx) of
  768.           'P': ps2:=true;
  769.           'V': noverify:=true;
  770.         end
  771.       else begin
  772.         val(copy(para,2,255),n,j);
  773.         if j<>0 then SyntaxError;
  774.         case UpCase(para[1]) of
  775.           'T':trk:=n;
  776.           'H':hds:=n;
  777.           'S':sec:=n;
  778.           'D':rde:=n;
  779.           'C':spc:=n;
  780.           'I':il:=n;
  781.           'G':gpl:=n;
  782.           'F':shift:=n;
  783.           'B':ForceType:=n;
  784.         end;
  785.       end;
  786.     end;
  787.   if sec>11 then hd:=true else hd:=false;
  788.   if rde=0 then
  789.     case hd of
  790.       true:  rde:=224;
  791.       false: rde:=112;
  792.     end;
  793.   if spc=0 then
  794.     case hd of
  795.       true:  spc:=1;
  796.       false: spc:=2;
  797.     end;
  798.   if il=0 then
  799.     if sec-lwsec in [3..8] then il:=2 else il:=1;
  800.   if not(hds in [1..2]) then begin
  801.     writeln(text57);
  802.     halt;
  803.   end;
  804.   if trk<1 then begin
  805.     writeln(text58);
  806.     halt;
  807.   end;
  808.   if il>=pred(sec) then begin
  809.     writeln(text59,pred(sec),text60);
  810.     halt;
  811.   end;
  812.   if not(spc in [1..2]) then
  813.     writeln(text61);
  814.   if ShortInt(trk-lwtrk)>4 then
  815.     writeln(text62);
  816.   if rde>240 then
  817.     writeln(text63);
  818.   writeln;
  819.   writeln(text64,chr(lw+$41),text65);
  820.   writeln(text66);
  821.   chx:=ReadKey;
  822.   format;
  823.   WriteBootSect;
  824. end.
  825.